home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / lcu.zip / LCU.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  28KB  |  1,038 lines
  1. {$R-}    {Range checking off}
  2. {$B-}    {Boolean complete evaluation off}
  3. {$S-}    {Stack checking off}
  4. {$N-}    {No numeric coprocessor}
  5. {$I-}    {IO Checking Off}
  6. {$D-}    {no debug information}
  7. {$T-}    {no TPM File}
  8.  
  9. {$M 65500, 16384, 655360} {Heap used for copying/comparing; 16K min arbitrary}
  10.  
  11. Program LCU;
  12. {Modified 7/3/88}
  13.  
  14. Uses
  15.   Crt, Dos, FileFcns, DrvParms, ErrProcs, Colors;
  16.  
  17. const
  18.    PathLength            = 67;
  19.  
  20. Type
  21.    FileSpecification    = record
  22.       DriveNum     : Integer;   {0=Current, A=1, B=2, etc}
  23.       Drive        : String[2]; {Drive Name, ended with ':'}
  24.       Path         : String[PathLength]; {Name of Path, ended with '\'}
  25.       Name         : String[8];  {Name of File}
  26.       Ext          : String[4];  {Extension, preceded by '.' if not empty}
  27.       end;
  28.  
  29.    FullPathName        = String[PathLength];
  30.    FindType        = (PathOnly, FileAndPath, Nothing);
  31.  
  32. Var
  33.    SearchRecord : SearchRec;
  34.  
  35.    SourceDriveSpec,
  36.    DestDriveSpec : DriveSpecification;
  37.  
  38.    CurrentPathFullName,
  39.    DefaultPathFullName,
  40.    SearchFullName,
  41.    ListFullName,
  42.    DestFullName         : FullPathName;
  43.  
  44.    CurrentPathSpecification,
  45.    DefaultPathSpecification,
  46.    SearchPathSpecification,
  47.    ListFileSpecification,
  48.    DestFileSpecification    : FileSpecification;
  49.  
  50.    Choice               : Char;
  51.  
  52.    FileAttribute        : word;
  53.    SetMask              : Integer;
  54.    ResetMask            : Integer;
  55.    OK                   : Boolean;
  56.  
  57. {***}
  58.  
  59. Procedure AnyKey2Continue;
  60. var
  61.    Answer : Char;
  62. begin
  63. TextColor(Emphasized);
  64. Writeln(#7, 'Press Any Key to Continue');
  65. Answer := ReadKey;
  66. TextColor(Foreground);
  67. end;
  68.  
  69. {***}
  70.  
  71. Procedure StringUpCase(var S:FullPathName);
  72. var
  73.    I : Integer;
  74. begin
  75. for I := 1 to length(S) do
  76.    S[I] := upcase(S[I]);
  77. end;
  78.  
  79. {***}
  80.  
  81. Procedure SplitLine(var LineEnd, LineStart: FullPathName; Position: Integer);
  82. begin
  83. LineStart   :=   copy(LineEnd, 1, position);
  84. Delete(LineEnd, 1, position);
  85. end;
  86.  
  87. {***}
  88.  
  89. Procedure ParseFileName(FullName: FullPathName;
  90.                   var ParsedName: FileSpecification);
  91. var
  92.    S : FullPathName;
  93.  
  94. begin
  95. with ParsedName do
  96. begin
  97. DriveNum := 0;
  98. Drive := '';
  99. Path  := '';
  100. Name  := '';
  101. Ext   := '';
  102.  
  103. if pos(':', FullName)>0 then
  104.    begin {Name contains drive specifier}
  105.       SplitLine(FullName, S, Pos(':', FullName) );
  106.       if pos('\',FullName) <> 1 then   {since drive specified, next character}
  107.          FullName := '\' + FullName;  {should be path separator             }
  108.       Drive := S;
  109.    end;
  110.  
  111. While pos('\', FullName)>0 do
  112.    begin
  113.       SplitLine(FullName, S, Pos('\', FullName) );
  114.       Path := Path + S;
  115.    end;
  116.  
  117. If pos('.', FullName)>0 then
  118.    begin
  119.       SplitLine(FullName, S, Pos('.', FullName)-1 );
  120.       Name := S;
  121.       Ext  := FullName;
  122.    end
  123. else
  124.    Name := FullName;
  125.  
  126. if ( (Drive='') and (Path='') ) then begin
  127.    Drive := DefaultPathSpecification.Drive;
  128.    Path  := DefaultPathSpecification.Path ;
  129.    end;
  130.  
  131. if (Drive='') then Drive := DefaultPathSpecification.Drive;
  132.  
  133. if Path[1]<>'\' then Path := DefaultPathSpecification.Path+ '\' + Path;
  134.  
  135. DriveNum := ord(Drive[1])-64;
  136. end; {With}
  137. end; {ParseFileName}
  138.  
  139. {***}
  140.  
  141. Procedure ConstructFileFullName(var FN: FullPathName; FS:FileSpecification);
  142. begin
  143. With FS do FN := Drive + Path + Name + Ext;
  144. end; {ConstructFileFullName}
  145.  
  146. {***}
  147.  
  148. Function DirExist(ND:FullPathName):Boolean;
  149. {Determines if Path Exists}
  150. Var
  151.    NDir : FileSpecification;
  152. Begin
  153. ParseFileName(ND, NDir);
  154. NDir.Name := '*';
  155. NDir.Ext  := '.*';
  156. ConstructFileFullName(ND, NDir);
  157. FindFirst(ND, ReadOnly+Archive, SearchRecord);
  158. ErrorNumber := IOResult;
  159. DirExist := (DosError<>3);
  160. end;
  161.  
  162. {***}
  163.  
  164. Function Exist(FileNameExt: FullPathName; var ErrorNumber:Integer):Boolean;
  165. {Determines if File Exists}
  166.  
  167. Begin
  168. FindFirst(FileNameExt, ReadOnly+Archive, SearchRecord);
  169. ErrorNumber := IOResult;
  170. Exist := (DosError=0);
  171. end;
  172.  
  173. {***}
  174.  
  175. Procedure ResetDefaultParms;
  176. begin
  177. DefaultPathSpecification.DriveNum := ListFileSpecification.DriveNum;
  178. DefaultPathSpecification.DRIVE    := ListFileSpecification.DRIVE;
  179. DefaultPathSpecification.PATH     := ListFileSpecification.PATH ;
  180. ConstructFileFullName(DefaultPathFullName, DefaultPathSpecification);
  181. end;
  182.  
  183. {***}
  184.  
  185. Procedure GetFileListName(var OK:Boolean; MustFind: FindType);
  186. begin
  187. OK := FALSE;
  188.  
  189. repeat
  190. TextColor(Foreground);
  191. Write('Please Enter Name of File List: '); ReadLn(ListFullName);
  192. StringUpCase(ListFullName);
  193. ParseFileName(ListFullName, ListFileSpecification);
  194.  
  195. with ListFileSpecification do begin
  196.    if (Name ='') then Name  := 'TEMPFILE';
  197.    if (Ext  ='') then Ext   := '.FFF';
  198.    end; {with}
  199.  
  200. ConstructFileFullName(ListFullName, ListFileSpecification);
  201.  
  202. if (MustFind=PathOnly) then
  203.    if DirExist(ListFullName) then begin
  204.       OK := TRUE;
  205.       ResetDefaultParms;
  206.       end;
  207.  
  208. if (MustFind=FileAndPath) then
  209.    if Exist(ListFullName, ErrorNumber) then begin
  210.       OK := TRUE;
  211.       ResetDefaultParms;
  212.       end;
  213.  
  214. TextColor(Warning);
  215. Case DosError of
  216.      2, 18 : if (MustFind=FileAndPath) then
  217.                 WriteLn('File Not Found: ', ListFullName);
  218.      3     : WriteLn('Path Not Found: ', ListFileSpecification.Drive +
  219.                                          ListFileSpecification.Path);
  220.      0     : begin
  221.              end;
  222.      else DisplayErrorMessages(DosError, [1..255]);
  223.      end; {Case}
  224.  
  225. until OK=TRUE;
  226. TextColor(Foreground);
  227. end; {GetFileListName}
  228.  
  229. {***}
  230.  
  231. Procedure GetSearchSpecification(var OK:Boolean; MustFind:FindType);
  232. begin
  233. OK := FALSE;
  234. repeat
  235. TextColor(ForeGround);
  236. Write('Please Enter Search Specification: ');
  237. ReadLn(SearchFullName);
  238. StringUpCase(SearchFullName);
  239. ParseFileName(SearchFullName, SearchPathSpecification);
  240. with SearchPathSpecification do begin
  241.    if (Name ='') then Name  := '*';
  242.    if (Ext  ='') then Ext   := '.*';
  243.    end; {with}
  244.  
  245. ConstructFileFullName(SearchFullName, SearchPathSpecification);
  246.  
  247. if (MustFind=PathOnly) then
  248.    if DirExist(SearchFullName) then begin
  249.       OK := TRUE;
  250.       ListFileSpecification.DriveNum := SearchPathSpecification.DriveNum;
  251.       ListFileSpecification.Drive    := SearchPathSpecification.Drive;
  252.       ListFileSpecification.Path     := SearchPathSpecification.Path ;
  253.       ConstructFileFullName(ListFullName, ListFileSpecification);
  254.       ResetDefaultParms;
  255.       end;
  256.  
  257. TextColor(Warning);
  258. Case DosError of
  259.      2, 18 : begin
  260.              end;
  261.      3     : WriteLn('Path Not Found: ', SearchPathSpecification.Drive +
  262.                                          SearchPathSpecification.Path);
  263.      0     : begin
  264.              end;
  265.      else DisplayErrorMessages(DosError, [1..255]);
  266.      end; {Case}
  267.  
  268. until (OK=TRUE);
  269. TextColor(Foreground);
  270. end; {GetSearchSpecification}
  271.  
  272. {***}
  273.  
  274. Procedure GetDestSpecification(var OK:Boolean; MustFind:FindType);
  275. begin
  276. OK := FALSE;
  277. repeat
  278.  
  279. TextColor(ForeGround);
  280. Write('Please Enter Destination Path : ');
  281. ReadLn(DestFullName);
  282. if DestFullName[length(DestFullName)] <> '\' then
  283.    DestFullName := DestFullName + '\';
  284. StringUpCase(DestFullName);
  285. ParseFileName(DestFullName, DestFileSpecification);
  286. with DestFileSpecification do begin
  287.    Name := '';
  288.    Ext  := '';
  289.    end; {with}
  290.  
  291. ConstructFileFullName(DestFullName, DestFileSpecification);
  292.  
  293. if (MustFind=PathOnly) then
  294.    if DirExist(DestFullName) then OK := TRUE;
  295.  
  296. TextColor(Warning);
  297. Case DosError of
  298.      2, 18 : begin
  299.              end;
  300.      3     : WriteLn('Path Not Found: ', DestFileSpecification.Drive +
  301.                                          DestFileSpecification.Path);
  302.      0     :
  303.      else DisplayErrorMessages(DosError, [1..255]);
  304.      end; {Case}
  305.  
  306. until (OK=TRUE);
  307. TextColor(Foreground);
  308. end; {GetDestSpecification}
  309.  
  310. {***}
  311.  
  312. Procedure StripListEntry(var ListEntry: FullPathName);
  313. begin
  314. if pos(' ', ListEntry)>0 then
  315.     ListEntry := copy(ListEntry, 1, pos(' ', ListEntry) -1);
  316. end;
  317.  
  318. {***}
  319.  
  320. Function Smart_FileExists(var S:FullPathName; Fixed:Boolean): Boolean;
  321. begin
  322. if (Exist(S, ErrorNumber)) then
  323.    begin
  324.    Smart_FileExists := TRUE;
  325.    exit;
  326.    end
  327. else
  328.    begin
  329.    TextColor(Warning);
  330.    WriteLn('File Not Found: ', S);
  331.    if Fixed=FALSE then
  332.       begin
  333.       WriteLn('Please Place Correct Disk in Drive ',
  334.                S[1],':');
  335.       AnyKey2Continue;
  336.       end;
  337.    end;
  338.  
  339. Smart_FileExists := Exist(S, ErrorNumber);
  340. TextColor(Foreground);
  341. end;
  342.  
  343. {***}
  344.  
  345. Procedure ListFile_Make;
  346. var
  347.    ListFile  : Text;
  348.  
  349. begin
  350. GetFileListName(OK, PathOnly);
  351. GetSearchSpecification(OK, PathOnly);
  352. Assign(ListFile,ListFullName);
  353. IOCheck(ErrorNumber, [1..255]-[2,18]);
  354. if (IOErr=TRUE) then Exit;
  355.  
  356. Rewrite(ListFile);
  357. IOCheck(ErrorNumber, [1..255]-[2,18]);
  358. if (IOErr=TRUE) then Exit;
  359.  
  360. TextColor(Emphasized);
  361. SourceDriveSpec.DriveNum := DefaultPathSpecification.Drivenum;
  362. DosGetDriveParms(SourceDriveSpec, ErrorNumber);
  363. WriteLn('Creating File: ', ListFullName, ' on ', SourceDriveSpec.DriveName);
  364. WriteLn;
  365. TextColor(ForeGround);
  366.  
  367. FindFirst(SearchFullName, ReadOnly+Archive, SearchRecord);
  368. While (DosError in ([0..255]-[2,18]) ) do begin
  369.    While (length(SearchRecord.Name)<12) do
  370.        SearchRecord.Name := SearchRecord.Name+' ';
  371.  
  372.    writeln(          SearchRecord.Name, '  (',SearchRecord.Size:8, ')');
  373.    writeln(ListFile, SearchRecord.Name, '  (',SearchRecord.Size:8, ')');
  374.    FindNext(SearchRecord);
  375.    end;
  376.  
  377. Writeln;
  378. close(ListFile);
  379. IOCheck(ErrorNumber, [1..255]);
  380. if ErrorNumber=0 then Writeln('List File Successfully Created: ',ListFullName);
  381. end;
  382.  
  383. {***}
  384.  
  385. Procedure ListFile_Attribute;
  386. var
  387.    InFile    : Text;
  388.    Choice    : String[8];
  389.    ListFile  : File;
  390.    ListEntry : FullPathName;
  391.  
  392. begin
  393. OK := FALSE;
  394. GetFileListName(OK, FileAndPath);
  395.  
  396. Assign(InFile,ListFullName);
  397. IOCheck(ErrorNumber, [1..255]);
  398. Reset(InFile);
  399. IOCheck(ErrorNumber, [1..255]);
  400. Writeln;
  401.  
  402. WriteLn('String Sets/Clears Attributes (Archive, System, Hidden, Read Only');
  403. WriteLn('  Upper Case SETs   Attribute ("ASHR")');
  404. WriteLn('  Lower Case CLEARs Attribute ("ashr")');
  405. Write  ('Please Enter Attribute List ("AaSsHhRr"): ');
  406. ReadLn(Choice);
  407. WriteLn;
  408. SetMask := 0;
  409. ResetMask := 0;
  410.  
  411. while Length(Choice) > 0 do begin
  412.    case Choice[1] of
  413.       'A':    SetMask :=   SetMask or Archive;
  414.       'a':  ResetMask := ResetMask or Archive;
  415.       'S':    SetMask :=   SetMask or SysFile;
  416.       's':  ResetMask := ResetMask or SysFile;
  417.       'H':    SetMask :=   SetMask or Hidden;
  418.       'h':  ResetMask := ResetMask or Hidden;
  419.       'R':    SetMask :=   SetMask or ReadOnly;
  420.       'r':  ResetMask := ResetMask or ReadOnly;
  421.    end; {case}
  422.    delete(Choice,1,1);
  423. end;
  424.  
  425. ResetMask := not ResetMask;
  426.  
  427. TextColor(Emphasized);
  428. SourceDriveSpec.DriveNum := DefaultPathSpecification.Drivenum;
  429. DosGetDriveParms(SourceDriveSpec, ErrorNumber);
  430. WriteLn('Changing Attributes on ', SourceDriveSpec.DriveName);
  431. WriteLn;
  432. TextColor(ForeGround);
  433.  
  434. While Not EOF(InFile) do
  435.    begin
  436.       ReadLn(InFile,ListEntry);
  437.       StripListEntry(ListEntry);
  438.       if ListEntry[1]='\' then ListEntry := DefaultPathSpecification.Drive + ListEntry
  439.       else
  440.          ListEntry := DefaultPathSpecification.Drive +
  441.                       DefaultPathSpecification.Path  +
  442.                       ListEntry;
  443.       if Smart_FileExists(ListEntry, SourceDriveSpec.Fixed) then
  444.          begin
  445.          Assign(ListFile, ListEntry);
  446.          IOCheck(ErrorNumber, [1..255]);
  447.          GetFAttr(ListFile, FileAttribute);
  448.          Write('Changing Attribute From ',FileAttribute:3);
  449.          FileAttribute := FileAttribute and ResetMask;
  450.          FileAttribute := FileAttribute  or   SetMask;
  451.          Writeln(' To ',FileAttribute:3,'     File: ',ListEntry);
  452.          SetFAttr(ListFile, FileAttribute);
  453.          end
  454.       else
  455.          begin
  456.          TextColor(Warning);
  457.          WriteLn('File Not Found: ',ListEntry);
  458.          TextColor(Foreground);
  459.          end;
  460.    end; {while}
  461.  
  462. Close( InFile);
  463. AnyKey2Continue;
  464. TextColor(ForeGround);
  465. end; {ListFile_Attribute}
  466.  
  467. {***}
  468.  
  469. Procedure ListFile_Copy;
  470.  
  471. var
  472.    ListEntry    : FullPathName;
  473.    SourceFile   : FullPathName;
  474.    DestFile     : FullPathName;
  475.    InFile       : Text;
  476.    ListFile     : File;
  477.  
  478. {**}
  479.  
  480. Procedure ProcessListEntry;
  481. begin
  482.       if ListEntry[1]='\' then begin
  483.          SourceFile := DefaultPathSpecification.Drive + ListEntry;
  484.          DestFile   := DestFileSpecification.Drive + ListEntry;
  485.          end
  486.       else
  487.          begin
  488.          SourceFile := DefaultPathSpecification.Drive +
  489.                        DefaultPathSpecification.Path  +
  490.                        ListEntry;
  491.          DestFile   := DestFileSpecification.Drive +
  492.                        DestFileSpecification.Path  +
  493.                        ListEntry;
  494.          end;
  495.  
  496.       if (Smart_FileExists(SourceFile, SourceDriveSpec.Fixed)=FALSE) then
  497.          begin
  498.          TextColor(Warning);
  499.          WriteLn('File Not Copied: ', SourceFile);
  500.          WriteLn;
  501.          TextColor(Foreground);
  502.          exit;
  503.          end;
  504.  
  505.       FileCopy(SourceFile, DestFile, DosError);
  506.  
  507.       if DosError=200 then
  508.          begin
  509.          TextColor(Warning);
  510.          WriteLn('Not enough space on Destination Drive for: ', SourceFile);
  511.             if DestDriveSpec.Fixed=FALSE then
  512.                begin
  513.                   WriteLn('Please Place a new disk in Drive ',
  514.                   DestFileSpecification.Drive);
  515.                   AnyKey2Continue;
  516.                   FileCopy(SourceFile, DestFile, DosError);
  517.                end;
  518.          end
  519.       else DisplayErrorMessages(DosError, [1..255]);
  520.  
  521.          {If Still not enough space, then exit}
  522.       if (DosError in [200, 210]) then begin
  523.          TextColor(Warning);
  524.          WriteLn('File Not Copied: ', SourceFile);
  525.          WriteLn;
  526.          TextColor(Foreground);
  527.          exit;
  528.          end
  529.       else DisplayErrorMessages(DosError, [1..255]);
  530.  
  531.       Assign(ListFile, SourceFile);
  532.       GetFAttr(ListFile, FileAttribute);
  533.       Assign(ListFile, DestFile);
  534.  
  535.       TextColor(Foreground);
  536.       if (FileAttribute and (Hidden+SysFile+ReadOnly) > 0) then
  537.          WriteLn(' [',FileAttribute,' --> ', FileAttribute, ']')
  538.       else
  539.          begin
  540.             GetFAttr(ListFile, FileAttribute);
  541.             Write(' [',FileAttribute,' --> ');
  542.             FileAttribute := FileAttribute and ResetMask;
  543.             Writeln(FileAttribute,']');
  544.          end;
  545.  
  546.       if FileComp(SourceFile,DestFile, DosError)=True then
  547.          Writeln('  *** Files are Identical ***') else
  548.          begin
  549.             TextColor(Emphasized);
  550.             Writeln('  *** Files are DIFFERENT ***');
  551.             TextColor(Foreground);
  552.          end;
  553.  
  554. Writeln;
  555. SetFAttr(ListFile, FileAttribute);
  556.  
  557. end;
  558.  
  559. {**}
  560.  
  561. begin
  562. GetFileListName(OK, FileAndPath);
  563. Assign(InFile,ListFullName);
  564. Reset(InFile);
  565. IOCheck(ErrorNumber, [1..255]);
  566.  
  567. GetDestSpecification(OK, PathOnly);
  568. WriteLn;
  569.  
  570. ResetMask := Archive;
  571. ResetMask := not ResetMask;
  572.  
  573. SourceDriveSpec.DriveNum := DefaultPathSpecification.Drivenum;
  574. DosGetDriveParms(SourceDriveSpec, ErrorNumber);
  575. DestDriveSpec.DriveNum := DestFileSpecification.DriveNum;
  576. DosGetDriveParms(DestDriveSpec, ErrorNumber);
  577.  
  578. TextColor(Emphasized);
  579. WriteLn('Copying From ', SourceDriveSpec.DriveName,
  580.         ' To ',          DestDriveSpec.DriveName);
  581. WriteLn('Available Memory =', MaxAvail:8, ' Bytes');
  582. WriteLn('Copy    Buffer   =', GetCopyBufferSize:8,    ' Bytes');
  583. WriteLn('Compare Buffer   =', GetCompareBufferSize:8, ' Bytes');
  584. WriteLn;
  585. TextColor(Foreground);
  586.  
  587. ListEntry := ListFileSpecification.Name + ListFileSpecification.Ext;
  588. ProcessListEntry;
  589. if (DestDriveSpec.fixed=TRUE) then begin
  590. {If Dest is a hard drive, use list on hard drive}
  591.     ListFileSpecification.Drive := DestFileSpecification.Drive;
  592.     ListFileSpecification.Path  := DestFileSpecification.Path;
  593.     ListFileSpecification.DriveNum := DestFileSpecification.DriveNum;
  594.     ConstructFileFullName(ListFullName, ListFileSpecification);
  595.     Close(InFile);
  596.     Assign(InFile, ListFullName);
  597.     Reset(InFile);
  598.     IOCheck(ErrorNumber, [1..255]);
  599.     end;
  600.  
  601. TextColor(Emphasized);
  602. WriteLn('Using List: ', ListFullName);
  603. TextColor(Foreground);
  604.  
  605. WriteLn;
  606.  
  607. While Not EOF(InFile) do
  608.    begin
  609.       ReadLn(InFile,ListEntry);
  610.       StripListEntry(ListEntry);
  611.       if (ListEntry<>(ListFileSpecification.Name+ListFileSpecification.Ext) )
  612.          then ProcessListEntry;
  613.    end;
  614.  
  615. Close(InFile);
  616. AnyKey2Continue;
  617. end; {ListFile_Copy}
  618.  
  619. {***}
  620.  
  621. Procedure ListFile_Verify;
  622. var
  623.    ListEntry    : FullPathName;
  624.    SourceFile   : FullPathName;
  625.    DestFile     : FullPathName;
  626.    InFile       : Text;
  627.  
  628. {**}
  629.    Procedure ProcessListEntry;
  630.       begin
  631.       TextColor(Foreground);
  632.  
  633.       if ListEntry[1]='\' then begin
  634.          SourceFile := DefaultPathSpecification.Drive + ListEntry;
  635.          DestFile   := DestFileSpecification.Drive + ListEntry;
  636.          end
  637.       else
  638.          begin
  639.          SourceFile := DefaultPathSpecification.Drive +
  640.                        DefaultPathSpecification.Path  +
  641.                        ListEntry;
  642.          DestFile   := DestFileSpecification.Drive +
  643.                        DestFileSpecification.Path  +
  644.                        ListEntry;
  645.          end;
  646.  
  647.       if (Smart_FileExists(SourceFile, SourceDriveSpec.Fixed)=FALSE) then
  648.          begin
  649.          TextColor(Warning);
  650.          WriteLn('File Not Verified: ', SourceFile);
  651.          WriteLn;
  652.          TextColor(Foreground);
  653.       exit;
  654.          end;
  655.  
  656.       if (Smart_FileExists(DestFile, DestDriveSpec.Fixed)=FALSE) then
  657.          begin
  658.          TextColor(Warning);
  659.          WriteLn('File Not Verified: ', DestFile);
  660.          WriteLn;
  661.          TextColor(Foreground);
  662.          exit;
  663.          end;
  664.  
  665.       if FileComp(SourceFile,DestFile, DosError)=True then
  666.          Writeln('  *** Files are Identical ***') else
  667.          begin
  668.             TextColor(Emphasized);
  669.             Writeln('  *** Files are DIFFERENT ***');
  670.             TextColor(Foreground);
  671.          end;
  672.       WriteLn;
  673.       end;
  674. {**}
  675.  
  676. begin
  677. GetFileListName(OK, FileAndPath);
  678. Assign(InFile,ListFullName);
  679. Reset(InFile);
  680. IOCheck(ErrorNumber, [1..255]);
  681.  
  682. GetDestSpecification(OK, PathOnly);
  683. Writeln;
  684.  
  685. SourceDriveSpec.DriveNum := DefaultPathSpecification.Drivenum;
  686. DosGetDriveParms(SourceDriveSpec, ErrorNumber);
  687. DestDriveSpec.DriveNum := DestFileSpecification.DriveNum;
  688. DosGetDriveParms(DestDriveSpec, ErrorNumber);
  689.  
  690. TextColor(Emphasized);
  691. WriteLn('Verifying From ', SourceDriveSpec.DriveName,
  692.         ' To ',          DestDriveSpec.DriveName);
  693. WriteLn('Available Memory =', MaxAvail:8, ' Bytes');
  694. WriteLn('Compare Buffer   =', GetCompareBufferSize:8, ' Bytes');
  695. WriteLn;
  696. TextColor(ForeGround);
  697.  
  698. While Not EOF(InFile) do begin
  699.    ReadLn(InFile,ListEntry);
  700.    StripListEntry(ListEntry);
  701.    ProcessListEntry;
  702.    end;
  703.  
  704. Close( InFile);
  705. AnyKey2Continue;
  706. end; {ListFile_Verify}
  707.  
  708. {***}
  709.  
  710. Procedure ListFile_Delete(FN:FullPathName);
  711. var
  712.    InFile       : Text;
  713.    FileToDelete : Text;
  714.    ListEntry    : FullPathName;
  715.    FS           : FileSpecification;
  716.    Attribute    : word;
  717.    C            : Char;
  718.  
  719. {**}
  720.    Procedure ProcessListEntry;
  721.    begin
  722.       if ListEntry[1]='\' then ListEntry := FS.Drive + ListEntry
  723.       else
  724.          ListEntry := FS.Drive + FS.Path + ListEntry;
  725.  
  726.       if (Smart_FileExists(ListEntry, SourceDriveSpec.Fixed)=FALSE) then
  727.          begin
  728.             TextColor(Warning);
  729.             WriteLn('File Not Deleted: ', ListEntry);
  730.             WriteLn;
  731.             TextColor(ForeGround);
  732.             exit;
  733.          end;
  734.  
  735.       Assign(FileToDelete, ListEntry);
  736.       GetFAttr(FileToDelete, Attribute);
  737.       if ( (Attribute and ReadOnly) > 0 ) then
  738.          begin
  739.            TextColor(Warning);
  740.            WriteLn('File is Read Only : ', ListEntry);
  741.            Write(#7, 'Would You Like to Delete it Anyway? ');
  742.            C := ReadKey;
  743.            C := upcase(C);
  744.            WriteLn(C);
  745.            If C = 'Y' then SetFAttr(FileToDelete,0)
  746.            else
  747.               begin
  748.                  WriteLn('File Not Deleted: ', ListEntry);
  749.                  TextColor(ForeGround);
  750.                  Close(FileToDelete);
  751.                  exit;
  752.               end;
  753.            TextColor(Foreground);
  754.       end;
  755.  
  756.       Erase(FileToDelete);
  757.       WriteLn('File Deleted: ', ListEntry);
  758.       WriteLn;
  759.    end;
  760. {**}
  761.  
  762. begin
  763. ParseFileName(FN, FS);
  764.  
  765. Assign(InFile,FN);
  766. Reset(InFile);
  767. IOCheck(ErrorNumber, [1..255]);
  768.  
  769. TextColor(Emphasized);
  770. SourceDriveSpec.DriveNum := DefaultPathSpecification.Drivenum;
  771. DosGetDriveParms(SourceDriveSpec, ErrorNumber);
  772. WriteLn('Deleting Files from ', SourceDriveSpec.DriveName);
  773. WriteLn;
  774. TextColor(ForeGround);
  775.  
  776. While Not EOF(InFile) do
  777.    begin
  778.       ReadLn(InFile,ListEntry);
  779.       StripListEntry(ListEntry);
  780.       if (ListEntry<>(FS.Name + FS.Ext) )
  781.          then ProcessListEntry;
  782.    end;
  783.  
  784. close(InFile);
  785. AnyKey2Continue;
  786. end; {ListFile_Delete}
  787.  
  788. {***}
  789.  
  790. Procedure ListFile_Merge;
  791.  
  792. var
  793.    InFile, OKMerge, NOMerge : Text;
  794.    ListFile       : File;
  795.    Answer         : String[3];
  796.    SourceFile     : FullPathName;
  797.    DestFile       : FullPathName;
  798.    ListEntry      : FullPathName;
  799.    FN_FFY         : FullPathName;
  800.    FN_FFN         : FullPathName;
  801.  
  802. {**}
  803.  
  804.    Procedure MergeCompare(SourceFile, DestFile, ListEntry : FullPathName);
  805.    Begin
  806.       if FileComp(SourceFile,DestFile, DosError)=True then
  807.          begin
  808.             Writeln('  *** Files are Identical ***');
  809.             WriteLn;
  810.             Writeln(OKMerge, ListEntry);
  811.             end
  812.      else
  813.          Begin
  814.             TextColor(Emphasized);
  815.             Writeln('  *** Files are DIFFERENT ***');
  816.             WriteLn;
  817.             Writeln(NOMerge, ListEntry);
  818.             TextColor(ForeGround);
  819.             end;
  820.    end; {MergeCompare}
  821.  
  822. {**}
  823.  
  824.    Procedure ProcessListEntry;
  825.    begin
  826.       if ListEntry[1]='\' then begin
  827.          SourceFile := DefaultPathSpecification.Drive + ListEntry;
  828.          DestFile   := DestFileSpecification.Drive + ListEntry;
  829.          end
  830.       else
  831.          begin
  832.          SourceFile := DefaultPathSpecification.Drive +
  833.                        DefaultPathSpecification.Path  +
  834.                        ListEntry;
  835.          DestFile   := DestFileSpecification.Drive +
  836.                        DestFileSpecification.Path  +
  837.                        ListEntry;
  838.          end;
  839.  
  840.       {If Source File Exists, then merge; Otherwise, skip}
  841.       if Exist(SourceFile, ErrorNumber)=FALSE then
  842.          begin
  843.             TextColor(Warning);
  844.             WriteLn('Source File Not Found/Not Merged: ', Sourcefile);
  845.             WriteLn;
  846.             TextColor(Foreground);
  847.             exit;
  848.          end;
  849.  
  850.       {if Destination File does not exist, copy source to target}
  851.       if not exist(DestFile, ErrorNumber) then
  852.          begin
  853.          FileCopy(SourceFile, DestFile, DosError);
  854.          if DosError=200 then
  855.             begin
  856.             TextColor(Warning);
  857.             WriteLn('Not enough space on Destination Drive for: ',
  858.                      SourceFile);
  859.             end;
  860.  
  861.          if DosError in [200, 210] then
  862.             begin
  863.             TextColor(Warning);
  864.             WriteLn('File Not Copied: ', SourceFile);
  865.             WriteLn;
  866.             TextColor(Foreground);
  867.             exit;
  868.             end;
  869.  
  870.             Assign(ListFile, SourceFile);
  871.             GetFAttr(ListFile, FileAttribute);
  872.             Assign(ListFile, DestFile);
  873.  
  874.             TextColor(Foreground);
  875.             if (FileAttribute and (Hidden+SysFile+ReadOnly) > 0) then
  876.                WriteLn(' [',FileAttribute,' --> ', FileAttribute, ']')
  877.             else
  878.                begin
  879.                   GetFAttr(ListFile, FileAttribute);
  880.                   Write(' [',FileAttribute,' --> ');
  881.                   FileAttribute := FileAttribute and ResetMask;
  882.                   Writeln(FileAttribute,']');
  883.                end;
  884.  
  885.          MergeCompare(SourceFile, DestFile, ListEntry);
  886.          SetFAttr(DestFile, FileAttribute);
  887.          end
  888.       else
  889.           {if it exists, compare source and target}
  890.           MergeCompare(SourceFile, DestFile, ListEntry);
  891.    end;
  892. {**}
  893.  
  894. begin
  895. GetFileListName(OK, FileAndPath);
  896. Assign(InFile,ListFullName);
  897. Reset(InFile);
  898. IOCheck(ErrorNumber, [1..255]-[2,18]);
  899.  
  900. OK := FALSE;
  901. GetDestSpecification(OK, PathOnly);
  902.  
  903. With ListFileSpecification do
  904.    FN_FFN := Drive + Path + Name + '.FFN';
  905. Assign(NOMerge, FN_FFN);
  906. ReWrite(NOMerge);
  907. IOCheck(ErrorNumber, [1..255]-[2,18]);
  908.  
  909. With ListFileSpecification do
  910.    FN_FFY := Drive + Path + Name + '.FFY';
  911. Assign(OKMerge, FN_FFY);
  912. ReWrite(OKMerge);
  913. IOCheck(ErrorNumber, [1..255]-[2,18]);
  914.  
  915. Writeln;
  916. ResetMask := Archive;
  917. ResetMask := not ResetMask;
  918.  
  919. SourceDriveSpec.DriveNum := DefaultPathSpecification.Drivenum;
  920. DosGetDriveParms(SourceDriveSpec, ErrorNumber);
  921. DestDriveSpec.DriveNum := DestFileSpecification.DriveNum;
  922. DosGetDriveParms(DestDriveSpec, ErrorNumber);
  923.  
  924. TextColor(Emphasized);
  925. WriteLn('Merging From ', SourceDriveSpec.DriveName,
  926.         ' To ',          DestDriveSpec.DriveName);
  927. WriteLn('Available Memory =', MaxAvail:8, ' Bytes');
  928. WriteLn('Copy    Buffer   =', GetCopyBufferSize:8,    ' Bytes');
  929. WriteLn('Compare Buffer   =', GetCompareBufferSize:8, ' Bytes');
  930. WriteLn;
  931. TextColor(ForeGround);
  932.  
  933. While Not EOF(InFile) do
  934.    begin
  935.       ReadLn(InFile,ListEntry);
  936.       StripListEntry(ListEntry);
  937.       ProcessListEntry;
  938.    end; {while}
  939.  
  940. Close( InFile);
  941. Close(OKMerge);
  942. Close(NoMerge);
  943. TextColor(Warning);
  944. Write(#7, 'Would you like to delete those files successfully merged? ');
  945. ReadLn(Answer);
  946. TextColor(Foreground);
  947. if upcase(Answer[1])='Y' then ListFile_Delete(FN_FFY);
  948.  
  949. end; {ListFile_Merge}
  950.  
  951. {**********************************}
  952.  
  953. {*** Beginning of Main Program *** }
  954.  
  955. begin
  956.    TextBackground(Background);
  957.    TextColor(Foreground);
  958.  
  959.    GetDir(0,CurrentPathFullName);
  960.    if CurrentPathFullName[length(CurrentPathFullName)] <> '\' then
  961.       CurrentPathFullName := CurrentPathFullName + '\';
  962.    ParseFileName(CurrentPathFullName, CurrentPathSpecification);
  963.    ConstructFileFullName(CurrentPathFullName, CurrentPathSpecification);
  964.  
  965.    DefaultPathFullName      := CurrentPathFullName;
  966.    DefaultPathSpecification := CurrentPathSpecification;
  967.  
  968. repeat
  969.    Choice := ' ';
  970.    ClrScr;
  971.    WriteLn('Original  DOS   Path: ', CurrentPathFullName);
  972.    WriteLn('Program Default Path: ', DefaultPathFullName);
  973.    WriteLn;
  974.    WriteLn('Do You Want To:');
  975.    WriteLn('   L : MAKE a List');
  976.    WriteLn('   A : Alter ATTRIBUTE of Files on a list');
  977.    WriteLn('   C : COPY List of Files to another directory, with verify');
  978.    WriteLn('   V : VERIFY a list of files to those in another directory');
  979.    WriteLn('   M : MERGE files in current directory into another directory');
  980.    WriteLn('   D : DELETE a list of files in the current directory');
  981.    WriteLn;
  982.    WriteLn('   X : EXIT program');
  983.    WriteLn;
  984.    Write  ('Please Enter Letter of Your Choice: ');
  985.    Choice := ReadKey;
  986.    Choice := upcase(Choice);
  987.  
  988.    Case Choice of
  989.       'L' : begin
  990.           WriteLn('L -> Make a List of Files');
  991.           ListFile_Make;
  992.           AnyKey2Continue;
  993.           end;
  994.  
  995.       'A' : begin
  996.           WriteLn('A -> Alter Attributes of a List of Files');
  997.           ListFile_Attribute;
  998.           end;
  999.  
  1000.       'C' : begin
  1001.           WriteLn('C -> Copy a List of Files');
  1002.           ListFile_Copy;
  1003.           end;
  1004.  
  1005.       'V' : begin
  1006.           WriteLn('V -> Verify a List of Files');
  1007.           ListFile_Verify;
  1008.           end;
  1009.  
  1010.       'M' : begin
  1011.           WriteLn('M -> Merge a List of Files');
  1012.           ListFile_Merge;
  1013.           end;
  1014.  
  1015.       'D' : begin
  1016.           WriteLn('D -> Delete a List of Files');
  1017.           GetFileListName(OK, FileAndPath);
  1018.           ListFile_Delete(ListFullName);
  1019.           end;
  1020.  
  1021.       'T' : Begin
  1022.           WriteLn('T -> Test a Procedure');
  1023.           AnyKey2Continue;
  1024.           end;
  1025.  
  1026.      'X' : Writeln('X -> EXIT PROGRAM');
  1027.  
  1028.      else
  1029.  
  1030.    end; {Case}
  1031.  
  1032. until choice = 'X';
  1033.  
  1034. NormVideo;
  1035. ClrScr;
  1036. ChDir(CurrentPathFullName);
  1037. end.
  1038.